home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / scm / wb1a1.lha / wb / example.scm < prev    next >
Encoding:
Text File  |  1993-06-29  |  3.4 KB  |  86 lines
  1. ; Wb-tree File Based Associative String Data Base System.
  2. ; Copyright (c) 1991, 1992, 1993 Holland Mark Martin
  3. ;
  4. ;Permission to use, copy, modify, and distribute this software and its
  5. ;documentation for educational, research, and non-profit purposes and
  6. ;without fee is hereby granted, provided that the above copyright
  7. ;notice appear in all copies and that both that copyright notice and
  8. ;this permission notice appear in supporting documentation, and that
  9. ;the name of Holland Mark Martin not be used in advertising or
  10. ;publicity pertaining to distribution of the software without specific,
  11. ;written prior consent in each case.  Permission to incorporate this
  12. ;software into commercial products can be obtained from Jonathan
  13. ;Finger, Holland Mark Martin, 174 Middlesex Turnpike, Burlington, MA,
  14. ;01803-4467, USA.  Holland Mark Martin makes no representations about
  15. ;the suitability or correctness of this software for any purpose.  It
  16. ;is provided "as is" without express or implied warranty.  Holland Mark
  17. ;Martin is under no obligation to provide any services, by way of
  18. ;maintenance, update, or otherwise.
  19.  
  20.  
  21. ;;;           MUMPS Style Database Phone Book Example
  22.  
  23. (make-seg 5 "mydata" 2048)
  24. (open-seg 5 "mydata" 2)            ;opens a previously created segment.
  25. (define pb (create-db 5 #\T "phone-book")) ;create an array called
  26.                     ;"phone-book" which will
  27.                     ;contain the phone book
  28.                     ;records.
  29. (define pi (create-db 5 #\T "phone-index"))    ;create an array called
  30.                     ;"phone-index" which we will
  31.                     ;use for indexing by phone
  32.                     ;number.
  33. (define lni (create-db 5 #\T "lastname-index"))
  34.                     ;create an array called
  35.                     ;"lastname-index" which we will
  36.                     ;use for indexing by last name
  37. (define record-number 0)
  38.  
  39. ;;;MAKE-NAME is a routine which concatenates its arguments together
  40. ;;;separated by control characters.  This assures that the arguments act
  41. ;;;as independent subscripts.
  42. (define (make-name arg1 . args)
  43.   (apply string-append
  44.      (if (number? arg1) (number->string arg1) arg1)
  45.      (apply append
  46.         (map (lambda (arg)
  47.                (cond ((equal? "" arg) (list stringofnull))
  48.                  ((number? arg)
  49.                   (set! arg (number->string arg))
  50.                   (list (string (integer->char
  51.                          (min 30 (string-length arg))))
  52.                     arg))
  53.                  (else (list (string (integer->char 30)) arg))))
  54.              args))))
  55.  
  56. (bt:put! pb (make-name record-number "LN") "Doe") ;last name
  57. (bt:put! pb (make-name record-number "FN") "Joe") ;first name
  58. (bt:put! pb (make-name record-number "PN") "5551212") ;phone number
  59. (bt:put! pb (make-name record-number "AD1") "13 Hi St.") ;street address
  60. (bt:put! pb (make-name record-number "CITY") "Podunk")
  61. (bt:put! pb (make-name record-number "ST") "NY")
  62. (bt:put! pb (make-name record-number "ZIP") "10000")
  63. (bt:put! lni (make-name "Doe" record-number) "")
  64.                     ;This adds index entry so that
  65.                     ;(bt:next lni (make-name "Doe")) 
  66.                     ;will find the record with
  67.                     ;complete information.
  68. (bt:put! pi (make-name "5551212" record-number) "")
  69.                     ;similarly for looking up by
  70.                     ;phone number.
  71.  
  72. ;;; Note we put the record number into the key.  This is so that we
  73. ;;; can index records for more than one "Doe".
  74.  
  75. ;(define doe-rec
  76. ;  (get-subscript
  77. ;   (bt:next lni (make-name "Doe"))        ;returns the a name which
  78. ;   2))                    ;includes the record number of
  79.                     ;the record.
  80.  
  81. ;(bt:get pb (make-name doe-rec "PN"))    ;returns Doe's Phone number.
  82.  
  83. (bt:scan pb 0 "" "zz" (lambda (k v) (print k v) #t) -1)
  84.  
  85. (close-seg 5 0)
  86.